### CODE FOR:
###
### Putting the partisan influence into political context:
### How party attachment and policy preference shape the effect of party cues
###
### PART 4: Conditional effect of party cues on party attachment
###         The results are included in the paper as Table 2 and Figure 4
###         (both in the main part of the paper).
###
### VERSION: 2023-MAY-11


rm(list=ls())
gc()


setwd("C:/Users/miros/Desktop/Research/Finland - Party cues in the context of policy preferences")




# LOADING LIBRARIES -------------------------------------------------------
library(haven)
library(dplyr)
library(ggplot2)
library(fixest)
library(tableHTML)
library(grid)
library(ggpubr)
library(RColorBrewer)





# DATA --------------------------------------------------------------------

# _ Import ---------------------------------------------------------------
# NOTE: The data file loaded in the next step was prepared in a separate
#       scripts '01_CuesInContext_data-prep.R'. If you haven't run the script, 
#       return to the depository and run that script first. Its output is 
#       'BIBU_long.Rda' loaded in the next step.

load("02-data/BIBU_long.Rda")





# DATA ADJUSTMENTS --------------------------------------------------------
# NOTE: The following part reshapes the data into a suitable format for the
#       fixed effects model estimation.


# Creating two subsets of data (one for each policy reform)
BIBU.long.TUBE <- na.omit(BIBU.long[c("RETIREMENT_TUBE", "Party.Closeness_BI", "MEMBERID", "ROUND", "GovParty.Overall")])
BIBU.long.SCHOOLING <- na.omit(BIBU.long[c("COMPULSORY_SCHOOLING", "Party.Closeness_BI", "MEMBERID", "ROUND", "GovParty.Overall")])

# Identifying those 'MEMBERID' which are included twice in the data.
# NOTE: The goal is to subset only those individuals who participated in
#       both waves and we have two data points for each of them.
BIBU.long.TUBE.twice <- data.frame(table(BIBU.long.TUBE$MEMBERID))
BIBU.long.TUBE.twice$Include <- ifelse(BIBU.long.TUBE.twice$Freq == 2, 1, 0)

BIBU.long.SCHOOLING.twice <- data.frame(table(BIBU.long.SCHOOLING$MEMBERID))
BIBU.long.SCHOOLING.twice$Include <- ifelse(BIBU.long.SCHOOLING.twice$Freq == 2, 1, 0)

# Attaching the 'Include' variable (identifying respondents participating in both waves)
BIBU.long.TUBE <- merge(BIBU.long.TUBE, 
                        BIBU.long.TUBE.twice[c("Var1", "Include")], 
                        by.x = "MEMBERID", by.y = "Var1")
BIBU.long.SCHOOLING <- merge(BIBU.long.SCHOOLING, 
                             BIBU.long.SCHOOLING.twice[c("Var1", "Include")], 
                             by.x = "MEMBERID", by.y = "Var1")

# Subsetting only relevant observations (i.e., people participating in both waves)
BIBU.long.TUBE <- subset(BIBU.long.TUBE, Include == 1)
BIBU.long.SCHOOLING <- subset(BIBU.long.SCHOOLING, Include == 1)

# Removing irrelevant objects and variables
BIBU.long.TUBE$Include <- NULL
BIBU.long.SCHOOLING$Include <- NULL
rm(BIBU.long.TUBE.twice, BIBU.long.SCHOOLING.twice)

# NOTE: Now, 'BIBU.long.TUBE' and 'BIBU.long.SCHOOLING' include only 
#       respondents participating in both waves and hence the objects
#       are ready for fixed effects model estimation.





# ANALYSIS ----------------------------------------------------------------
# NOTE: The following part of the analysis examines the conditional effect
#       of the party cues on voters' degree of party attachment. Estimated 
#       are fixed effects models examining the revealed individual-level
#       shifts in policy preferences regarding the two reforms enacted by
#       the Finnish government.




# _ TABLE 1 ---------------------------------------------------------------

# Adjusting the factor levels (so the relevant coefficients relate to the
# government voters - i.e., the main group of interest)
BIBU.long.TUBE$GovParty.Overall <- factor(BIBU.long.TUBE$GovParty.Overall,
                                          levels = c("Opposition voters", 
                                                     "Government voters"))

BIBU.long.SCHOOLING$GovParty.Overall <- factor(BIBU.long.SCHOOLING$GovParty.Overall,
                                               levels = c("Opposition voters", 
                                                          "Government voters"))



# __ Model estimation -----------------------------------------------------

# Model 1: Abolishment of the 'Retirement Tube'
# Setting factor levels for more intuitive interpretation
BIBU.long.SCHOOLING$Party.Closeness_BI <- factor(BIBU.long.SCHOOLING$Party.Closeness_BI, 
                                                 levels = c("Not very & not at all close", "Very & somewhat close"))

# Model
fd.model.1 <- feols(RETIREMENT_TUBE ~ ROUND*Party.Closeness_BI | MEMBERID, 
                    data = filter(BIBU.long.TUBE, GovParty.Overall == "Government voters"), 
                    cluster = "MEMBERID")

# Model 2: Increase of the upper age limit for compulsory schooling
# Setting factor levels for more intuitive interpretation
BIBU.long.SCHOOLING$Party.Closeness_BI <- factor(BIBU.long.SCHOOLING$Party.Closeness_BI, 
                                                 levels = c("Very & somewhat close", "Not very & not at all close"))

# Model
fd.model.2 <- feols(COMPULSORY_SCHOOLING ~ ROUND*Party.Closeness_BI | MEMBERID, 
                    data = filter(BIBU.long.SCHOOLING, GovParty.Overall == "Government voters"), 
                    cluster = "MEMBERID")

# Model(s) summary
etable(fd.model.1, fd.model.2)



# Exporting the table
write_tableHTML(
  tableHTML(
    etable(fd.model.1, fd.model.2, tex = FALSE)), 
  file = "04-figures and models/Tab 1 - conditionality on party attachment - government.html")





# _ FIGURE 3 --------------------------------------------------------------

# __ Extracting the marginal effects --------------------------------------
margins <-
  data.frame(
    rbind(
      c("Abolishment of\nthe 'Retirement Tube'",      "Before\nthe reform\n(September 2020)",  "Government voters:\nClose to the party",     0, NA, NA),
      c("Extension of\nthe compulsory schooling age", "Before\nthe reform\n(September 2020)",  "Government voters:\nNot close to the party", 0, NA, NA),
      c("Abolishment of\nthe 'Retirement Tube'",      "After\nthe reform\n(February 2021)", "Government voters:\nClose to the party",     broom::tidy(fd.model.1, conf.int = .95)[2, c("estimate", "conf.low", "conf.high")]),
      c("Extension of\nthe compulsory schooling age", "After\nthe reform\n(February 2021)", "Government voters:\nNot close to the party", broom::tidy(fd.model.2, conf.int = .95)[2, c("estimate", "conf.low", "conf.high")])
    ))

# Changing names
names(margins) <- c("reform", "time", "group", "estimate", "conf.low", "conf.high")

# Unlisting the rows
margins$reform <- factor(unlist(margins$reform), levels = c("Abolishment of\nthe 'Retirement Tube'", "Extension of\nthe compulsory schooling age"))
margins$time <- factor(unlist(margins$time), levels = c("Before\nthe reform\n(September 2020)", "After\nthe reform\n(February 2021)"))
margins$estimate <- as.numeric(unlist(margins$estimate))
margins$conf.low <- as.numeric(unlist(margins$conf.low))
margins$conf.high <- as.numeric(unlist(margins$conf.high))




# __ Figure ---------------------------------------------------------------

ggarrange(
  
  # Abolishment of the retirement tube
  ggplot(subset(margins, reform == "Abolishment of\nthe 'Retirement Tube'"), 
         aes(x = time, y = estimate, group = reform)) +
    geom_hline(yintercept = 0, colour = "grey60", linetype = "longdash") +
    geom_point() +
    geom_line() +
    annotate("richtext", x = 2.5, y = -0.0525, hjust = 1, vjust = 0.5, 
             label = "Reference: <b>Weakly</b> attached<br>government voters", 
             size = 7/.pt, colour = "grey60", lineheight = 0.8, fill = NA, label.color = NA) +
    annotate("richtext", x = 2.0, y = 0.2398000, hjust = 0, vjust = 0.5, 
             label = "<b>Strongly</b><br>attached<br>government<br>voters", 
             size = 7/.pt, lineheight = 0.8, fill = NA, label.color = NA) +
    geom_errorbar(aes(ymin = conf.low, ymax = conf.high), width = 0.2) +
    scale_y_continuous(breaks = seq(-0.5, 0.5, 0.125), labels = c("-0.50", "", "-0.25", "", "0.00", "", "0.25", "", "0.50")) +
    geom_rect(ymin = 0.5, ymax = 0.7, xmin = 0.5, xmax = 2.5, colour = "black", fill = "grey90") +
    annotate("text", x = 1.5, y = 0.6, hjust = 0.5, vjust = -0.10, label = "Unpopular policy reform", fontface = 2, size = 11/.pt) +
    annotate("text", x = 1.5, y = 0.6, hjust = 0.5, vjust =  1.70, label = "Abolition of the 'retirement tube'", size = 8/.pt) +
    coord_cartesian(xlim = c(0.5, 2.5), ylim = c(-0.5, 0.7), expand = FALSE, clip = "off") +
    labs(y = expression(paste(symbol('\254'), " Lower support ",~-~bold(Estimate)~-~" Higher support ", symbol('\256'), "                ")), x = NULL, title = NULL) +
    theme(axis.title.y = element_text(size = 8),
          axis.text = element_text(size = 8),
          panel.grid.major.x = element_blank(), 
          panel.grid.major.y = element_line(colour = "gray90"), 
          panel.grid.minor.y = element_line(colour = "gray90"),
          panel.background = element_rect(fill = "transparent", colour = "black"),
          plot.background = element_rect(fill = "transparent", colour = "transparent"),
          panel.border = element_rect(fill = "transparent", colour = "black"),
          axis.ticks.y = element_blank(),
          plot.margin = unit(c(0.05, 0.05, 0.05, 0.05),"cm")),
  
  
  # Compulsory schooling extension
  ggplot(subset(margins, reform == "Extension of\nthe compulsory schooling age"), 
         aes(x = time, y = estimate, group = reform)) +
    geom_hline(yintercept = 0, colour = "grey60", linetype = "longdash") +
    geom_point() +
    geom_line() +
    annotate("richtext", x = 2.5, y = -0.0525, hjust = 1, vjust = 0.5, 
             label = "Reference: <b>Strongly</b> attached<br>government voters", 
             size = 7/.pt, colour = "grey60", lineheight = 0.8, fill = NA, label.color = NA) +
    annotate("richtext", x = 2.0, y = 0.1969618, hjust = 0, vjust = 0.5, 
             label = "<b>Weakly</b><br>attached<br>government<br>voters", 
             size = 7/.pt, lineheight = 0.8, fill = NA, label.color = NA) +
    geom_errorbar(aes(ymin = conf.low, ymax = conf.high), width = 0.2) +
    scale_y_continuous(breaks = seq(-0.5, 0.5, 0.125), labels = c("-0.50", "", "-0.25", "", "0.00", "", "0.25", "", "0.50")) +
    geom_rect(ymin = 0.5, ymax = 0.7, xmin = 0.5, xmax = 2.5, colour = "black", fill = "grey90") +
    annotate("text", x = 1.5, y = 0.6, hjust = 0.5, vjust = -0.10, label = "Popular policy reform", fontface = 2, size = 11/.pt) +
    annotate("text", x = 1.5, y = 0.6, hjust = 0.5, vjust =  1.70, label = "Extension of the compulsory schooling age", size = 8/.pt) +
    coord_cartesian(xlim = c(0.5, 2.5), ylim = c(-0.5, 0.7), expand = FALSE, clip = "off") +
    labs(y = NULL, x = NULL, title = NULL) +
    theme(axis.title.y = element_text(size = 9),
          axis.text.y = element_blank(),
          axis.text = element_text(size = 8),
          panel.grid.major.x = element_blank(), 
          panel.grid.major.y = element_line(colour = "gray90"), 
          panel.grid.minor.y = element_line(colour = "gray90"),
          panel.background = element_rect(fill = "transparent", colour = "black"),
          plot.background = element_rect(fill = "transparent", colour = "transparent"),
          panel.border = element_rect(fill = "transparent", colour = "black"),
          axis.ticks.y = element_blank(),
          plot.margin = unit(c(0.05, 0.05, 0.05, 0.05),"cm")),
  
  
  # Specs
  nrow = 1, widths = c(10, 8.75)) + 
  theme(panel.background = element_rect(fill = "white", color = "transparent"))


# Saving the output
ggsave(filename = "04-figures and models/Fig 4 - party closeness.png", width = 14.5, height = 10, units = "cm", dpi = 600)



# Interim cleanup
rm(fd.model.1, fd.model.2, margins)







# ANALYSIS: Robustness test with opposition voters ------------------------
# NOTE: The following part of the analysis is a robustness test examining 
#       the conditional effect of party cues on voters of the opposition
#       parties. Also in this case, estimated are fixed effects models 
#       examining the revealed individual-level shifts in policy preferences
#       regarding the two reforms enacted by the Finnish government.




# _ TABLE A2 ---------------------------------------------------------------

# __ Model estimation -----------------------------------------------------

# Model 1: Abolishment of the 'Retirement Tube'
# Setting factor levels for more intuitive interpretation
BIBU.long.SCHOOLING$Party.Closeness_BI <- factor(BIBU.long.SCHOOLING$Party.Closeness_BI, 
                                                 levels = c("Not very & not at all close", "Very & somewhat close"))

# Model
fd.model.1 <- feols(RETIREMENT_TUBE ~ ROUND*Party.Closeness_BI | MEMBERID, 
                    data = filter(BIBU.long.TUBE, GovParty.Overall == "Opposition voters"), 
                    cluster = "MEMBERID")

# Model 2: Increase of the upper age limit for compulsory schooling
# Setting factor levels for more intuitive interpretation
BIBU.long.SCHOOLING$Party.Closeness_BI <- factor(BIBU.long.SCHOOLING$Party.Closeness_BI, 
                                                 levels = c("Very & somewhat close", "Not very & not at all close"))

# Model
fd.model.2 <- feols(COMPULSORY_SCHOOLING ~ ROUND*Party.Closeness_BI | MEMBERID, 
                    data = filter(BIBU.long.SCHOOLING, GovParty.Overall == "Opposition voters"), 
                    cluster = "MEMBERID")

# Model(s) summary
etable(fd.model.1, fd.model.2)



# Exporting the table
write_tableHTML(
  tableHTML(
    etable(fd.model.1, fd.model.2, tex = FALSE)), 
  file = "04-figures and models/Tab A2 - conditionality on party attachment - opposition.html")




# _ FIGURE A6 -------------------------------------------------------------

# __ Extracting the marginal effects --------------------------------------
margins <-
  data.frame(
    rbind(
      c("Abolishment of\nthe 'Retirement Tube'",      "Before\nthe reform\n(September 2020)",  "Opposition voters:\nClose to the party",     0, NA, NA),
      c("Extension of\nthe compulsory schooling age", "Before\nthe reform\n(September 2020)",  "Opposition voters:\nNot close to the party", 0, NA, NA),
      c("Abolishment of\nthe 'Retirement Tube'",      "After\nthe reform\n(February 2021)", "Opposition voters:\nClose to the party",     broom::tidy(fd.model.1, conf.int = .95)[2, c("estimate", "conf.low", "conf.high")]),
      c("Extension of\nthe compulsory schooling age", "After\nthe reform\n(February 2021)", "Opposition voters:\nNot close to the party", broom::tidy(fd.model.2, conf.int = .95)[2, c("estimate", "conf.low", "conf.high")])
    ))

# Changing names
names(margins) <- c("reform", "time", "group", "estimate", "conf.low", "conf.high")

# Unlisting the rows
margins$reform <- factor(unlist(margins$reform), levels = c("Abolishment of\nthe 'Retirement Tube'", "Extension of\nthe compulsory schooling age"))
margins$time <- factor(unlist(margins$time), levels = c("Before\nthe reform\n(September 2020)", "After\nthe reform\n(February 2021)"))
margins$estimate <- as.numeric(unlist(margins$estimate))
margins$conf.low <- as.numeric(unlist(margins$conf.low))
margins$conf.high <- as.numeric(unlist(margins$conf.high))




# __ Figure ---------------------------------------------------------------

ggarrange(
  
  # Abolishment of the retirement tube
  ggplot(subset(margins, reform == "Abolishment of\nthe 'Retirement Tube'"), 
         aes(x = time, y = estimate, group = reform)) +
    geom_hline(yintercept = 0, colour = "grey60", linetype = "longdash") +
    geom_point() +
    geom_line() +
    annotate("richtext", x = 0.5, y = -0.0525, hjust = 0, vjust = 0.5, 
             label = "Reference: <b>Weakly</b> attached<br>opposition voters", 
             size = 7/.pt, colour = "grey60", lineheight = 0.8, fill = NA, label.color = NA) +
    annotate("richtext", x = 2.0, y = 0.06548921, hjust = 0, vjust = 0.5, 
             label = "<b>Strongly</b><br>attached<br>opposition<br>voters", 
             size = 7/.pt, lineheight = 0.8, fill = NA, label.color = NA) +
    geom_errorbar(aes(ymin = conf.low, ymax = conf.high), width = 0.2) +
    scale_y_continuous(breaks = seq(-0.5, 0.5, 0.125), labels = c("-0.50", "", "-0.25", "", "0.00", "", "0.25", "", "0.50")) +
    geom_rect(ymin = 0.5, ymax = 0.7, xmin = 0.5, xmax = 2.5, colour = "black", fill = "grey90") +
    annotate("text", x = 1.5, y = 0.6, hjust = 0.5, vjust = -0.10, label = "Unpopular policy reform", fontface = 2, size = 11/.pt) +
    annotate("text", x = 1.5, y = 0.6, hjust = 0.5, vjust =  1.70, label = "Abolition of the 'retirement tube'", size = 8/.pt) +
    coord_cartesian(xlim = c(0.5, 2.5), ylim = c(-0.5, 0.7), expand = FALSE, clip = "off") +
    labs(y = expression(paste(symbol('\254'), " Lower support ",~-~bold(Estimate)~-~" Higher support ", symbol('\256'), "                ")), x = NULL, title = NULL) +
    theme(axis.title.y = element_text(size = 8),
          axis.text = element_text(size = 8),
          panel.grid.major.x = element_blank(), 
          panel.grid.major.y = element_line(colour = "gray90"), 
          panel.grid.minor.y = element_line(colour = "gray90"),
          panel.background = element_rect(fill = "transparent", colour = "black"),
          plot.background = element_rect(fill = "transparent", colour = "transparent"),
          panel.border = element_rect(fill = "transparent", colour = "black"),
          axis.ticks.y = element_blank(),
          plot.margin = unit(c(0.05, 0.05, 0.05, 0.05),"cm")),
  
  
  # Compulsory schooling extension
  ggplot(subset(margins, reform == "Extension of\nthe compulsory schooling age"), 
         aes(x = time, y = estimate, group = reform)) +
    geom_hline(yintercept = 0, colour = "grey60", linetype = "longdash") +
    geom_point() +
    geom_line() +
    annotate("richtext", x = 0.5, y = -0.0525, hjust = 0, vjust = 0.5, 
             label = "Reference: <b>Strongly</b> attached<br>opposition voters", 
             size = 7/.pt, colour = "grey60", lineheight = 0.8, fill = NA, label.color = NA) +
    annotate("richtext", x = 2.0, y = 0.15524877, hjust = 0, vjust = 0.5, 
             label = "<b>Weakly</b><br>attached<br>opposition<br>voters", 
             size = 7/.pt, lineheight = 0.8, fill = NA, label.color = NA) +
    geom_errorbar(aes(ymin = conf.low, ymax = conf.high), width = 0.2) +
    scale_y_continuous(breaks = seq(-0.5, 0.5, 0.125), labels = c("-0.50", "", "-0.25", "", "0.00", "", "0.25", "", "0.50")) +
    geom_rect(ymin = 0.5, ymax = 0.7, xmin = 0.5, xmax = 2.5, colour = "black", fill = "grey90") +
    annotate("text", x = 1.5, y = 0.6, hjust = 0.5, vjust = -0.10, label = "Popular policy reform", fontface = 2, size = 11/.pt) +
    annotate("text", x = 1.5, y = 0.6, hjust = 0.5, vjust =  1.70, label = "Extension of the compulsory schooling age", size = 8/.pt) +
    coord_cartesian(xlim = c(0.5, 2.5), ylim = c(-0.5, 0.7), expand = FALSE, clip = "off") +
    labs(y = NULL, x = NULL, title = NULL) +
    theme(axis.title.y = element_text(size = 9),
          axis.text.y = element_blank(),
          axis.text = element_text(size = 8),
          panel.grid.major.x = element_blank(), 
          panel.grid.major.y = element_line(colour = "gray90"), 
          panel.grid.minor.y = element_line(colour = "gray90"),
          panel.background = element_rect(fill = "transparent", colour = "black"),
          plot.background = element_rect(fill = "transparent", colour = "transparent"),
          panel.border = element_rect(fill = "transparent", colour = "black"),
          axis.ticks.y = element_blank(),
          plot.margin = unit(c(0.05, 0.05, 0.05, 0.05),"cm")),
  
  
  # Specs
  nrow = 1, widths = c(10, 8.75)) + 
  theme(panel.background = element_rect(fill = "white", color = "transparent"))


# Saving the output
ggsave(filename = "04-figures and models/Fig A6 - party closeness - opposition.png", width = 14.5, height = 10, units = "cm", dpi = 600)


# Cleanup
rm(BIBU.long.TUBE, BIBU.long.SCHOOLING, fd.model.1, fd.model.2, margins)
